Loadstar 84/084.d81/source codes/HIGH SCORES.EBUD

Text File | 2022-08-26 | 6KB | 552 lines

;Instant high score file

open =$ffc0
readst =$ffb7
setlfs =$ffba
setnam =$ffbd
load =$ffd5
getin =$ffe4
clrchn =$ffcc
close =$ffc3   ;a
chrin =$ffcf
chkout =$ffc9  ;x
chkin =$ffc6   ;x
plot =$fff0
chrout =$ffd2
color'pointer =243
screen'line'pointer =209
print'number =$bdcd ;x,a
clear'line =59903

.org $c000
.mem
;obj "scores c000"
jmp menu
jmp load'scores
jmp save'scores
jmp clear'high'scores

menu lda #255
sta temp

- jsr $aefd
jsr $ad8a
jsr $b7f7
inc temp
ldy temp
bne +
lda $14
sta petition
lda $15
sta petition+1
+ lda $14
sta top'color-1,y
cpy #3
bne -

clear'line'links ldy #24
- lda 217,y
ora #128
sta 217,y
dey
bpl -

position'to'draw'box ldx #5
ldy #0
clc
jsr plot

draw'box ldx #14
- ldy #35

- lda #160   ;reverse space

sta (screen'line'pointer),y

lda middle'color
cpx #14
bne +
lda top'color
jmp +
+ cpx #1
bne +
lda bottom'color

+ sta (color'pointer),y
dey
cpy #3
bne -

dex
beq print'names
stx temp
inc 214
jsr 58732
ldx temp
bne --

print'names ldx #7
ldy #6
clc
jsr plot

fill'empty ldx #10
stx temp
lda middle'color
sta 646

inc 199          ;reverse video

- ldy #0
- lda default,y
beq print'default'score
jsr chrout
iny
bne -

print'default'score lda #28
sta 211
jsr 58732
ldy #0

- lda default'score,y
beq finished'defaults
jsr chrout
iny
bne -

finished'defaults inc 214
lda #6
sta 211
jsr 58732

dec temp
bne ---
jsr search'for'lower'score
lda "0"
bit flag
bvc +
lda "1"
+ sta 631
lda #1
sta 198
rts



clear'high'scores ldy #239
lda #0
- sta names,y
dey
cpy #255
bne -
rts

load'scores jsr $aefd
jsr $ad9e
jsr $b6a3

jsr setnam
lda #2
ldx 186
cpx #8
bcs +
ldx #8
+ ldy #2
jsr setlfs
jsr open

jsr clrchn
ldx #2
jsr chkin

ldy #0

- jsr chrin
sta names,y
iny
cpy #240
bne -

jsr clrchn
lda #2
jmp close

save'scores jsr $aefd
jsr $ad9e
jsr $b6a3

jsr setnam
lda #2
ldx 186
cpx #8
bcs +
ldx #8
+ ldy #1
jsr setlfs
jsr open

jsr clrchn
ldx #2
jsr chkout

ldy #0

- lda names,y
jsr chrout
iny
cpy #240
bne -

jsr clrchn
lda #2
jmp close


get'line ldy #19
lda #0
clear'string sta string,y
dey
bpl clear'string

ldy #35
lda #160
- sta (screen'line'pointer),y
dey
cpy #5
bne -

lda #28
sta 211
jsr 58732
lda petition+1
ldx petition
jsr print'number

lda #6
sta 211
jsr 58732

ldy #19
lda #0
- sta string,y
dey
bpl -
lda #0
sta string'length
sta 198
lda 211
sta starting'position
lda #">"
inc 199;      reverse video
jsr $ffd2
lda #157
jsr $ffd2

wait'for'key jsr getin
beq wait'for'key
;jmp +
bit middle'color
bpl +
pha
lda 653
cmp #1
beq shift'on
pla
jmp +
shift'on pla
bne wait'for'key

+ cmp #13
beq return
cmp #20
beq delete

cmp #32
bcc wait'for'key
cmp #91
bcc okay'input
cmp #193
bcc wait'for'key
cmp #219
bcc okay'input
jmp wait'for'key

return lda " "
jsr chrout
ldx #23
jsr clear'line
rts

delete lda string'length
beq wait'for'key
lda #" "
jsr $ffd2
lda #157
jsr $ffd2
jsr $ffd2
lda #"<"
jsr $ffd2
lda #157
jsr $ffd2
dec string'length
jmp wait'for'key

okay'input sta temp
lda string'length
cmp #19
beq wait'for'key
tay
lda temp
sta string,y
jsr $ffd2
lda #">"
jsr $ffd2
lda #157
jsr $ffd2
inc string'length
jmp wait'for'key

search'for'lower'score lda #0
sta flag
sta slot'number
lda <scores
sta 253
lda >scores
sta 254

- lda slot'number
cmp #10
beq ran'out'of'slots

ldy #1
lda petition+1
cmp (253),y
bcc next'score
bne insert'names

dey
lda petition
cmp (253),y
beq next'score
bcs insert'names

next'score inc slot'number
lda 253
clc
adc #2
sta 253
bcc +
inc 254

+ lda 251
clc
adc #20
sta 251
bcc +
inc 252

+ jmp -

ran'out'of'slots jmp print'stored'names

insert'names lda #255
sta flag
jsr print'congrats
lda slot'number
cmp #10
bne +
rts
+ tay
lda name'constants,y
sta goal
dec goal

ldx #219; destination
ldy #199; source

move'names lda names,y
sta names,x
dey
dex
cpy goal
bne move'names

insert'scores lda slot'number
tay
lda score'constants,y
sta goal
dec goal

ldx #21; destination
ldy #19; source

move'scores lda scores,y
sta scores,x
dey
dex
cpy goal
bne move'scores

jsr print'stored'names

alright lda slot'number
clc
adc #7
tax
clc
ldy #6
jsr plot
jsr get'line

lda slot'number
tay
lda score'constants,y
tax
lda petition
sta scores,x
inx
lda petition+1
sta scores,x

lda slot'number
tay
lda name'constants,y
tax
ldy #0
- lda string,y
sta names,x
inx
iny
cpy #20
bne -
rts

print'stored'names lda <names
sta 251
lda >names
sta 252

lda <scores
sta 253
lda >scores
sta 254

position'to'print'stored'names ldx #7
ldy #6
clc
jsr plot

ldx #10
stx temp
stx 199
lda middle'color
sta 646

print'it ldy #0
- lda (251),y
beq pad'out
jsr chrout
iny
cpy #20
bne -

pad'out cpy #0
beq print'score

lda #32
- jsr chrout
iny
cpy #20
bcc -

print'score lda #28
sta 211
jsr 58732
ldy #1
lda (253),y
dey
pha
lda (253),y
tax
pla
jsr print'number

ldx temp
cpx #1
beq quit'printing
dex
stx temp

lda 251
clc
adc #20
sta 251
bcc +
inc 252

+ lda 253
clc
adc #2
sta 253
bcc +
inc 254

+ inc 214
lda #6
sta 211
jsr 58732

jmp print'it

quit'printing rts

print'congrats ldx #23
ldy #4
clc
jsr plot

lda middle'color
sta 646

bmi ucase

ldy #0
sty 199
- lda congrats'script,y
beq +
jsr chrout
iny
bne -
+ rts

ucase ldy #0
sty 199
- lda congrats'upper,y
beq +
jsr chrout
iny
bne -
+ rts

flag .byt 0
string .buf 20
string'length .byt 0
starting'position .byt 0
temp .byt 0
default .asc "Empty":.byt 0
default'score .asc "0":.byt 0
petition .word 0
parameter .buf 4
slot'number .byt 0
top'color .byt 1
middle'color .byt 3
bottom'color .byt 14
name'constants .byt 0,20,40,60,80,100,120,140,160,180
score'constants .byt 0,2,4,6,8,10,12,14,16,18
goal .byt 0
congrats'script .asc "Congratulations!  Enter Your Name":.byt 0
congrats'upper .asc "congratulations!  enter your name":.byt 0
names .buf 220
scores .buf 22